home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / HSBASIC2.DMS / in.adf / HB2Examples2.0.Lha / Examples / EmBClass / EmBClass.bas < prev    next >
Encoding:
BASIC Source File  |  1994-04-14  |  3.0 KB  |  131 lines
  1. ''
  2. '' $Id: EmBClass.bas,v 1.2 1994/03/16 12:12:10 alex Rel $
  3. ''
  4. '' Implementation of a BOOPSI private image class
  5. ''
  6. '' Derived from Commodore-Amiga example (c) Copyright 1992 Commodore-Amiga, Inc.
  7. ''
  8.  
  9. CONST LINEWIDTH = 1    ' not variable, not fancy
  10.  
  11. ' fill region centered in a box
  12. SUB interiorBox(BYVAL rp&, BYVAL l, BYVAL t, BYVAL w, BYVAL h, _
  13.   BYVAL xw, BYVAL yw, BYVAL pen)
  14.     IF w > (xw << 1) AND h > (yw << 1) THEN
  15.         POKEB rp& + RastPortMask, NOT 0
  16.         BNDRYOFF rp&
  17.         SetAfPt rp&, NULL&, 0
  18.         SetDrMd rp&, JAM2&
  19.         SetAPen rp&, pen
  20.         RectFill rp&, l + xw, t + yw, l + w - 1 - xw, t + h - 1 - yw
  21.     END IF
  22. END SUB
  23.  
  24. SUB embossedBoxTrim(BYVAL rp&, BYVAL l, BYVAL t, BYVAL w, BYVAL h, _
  25.   BYVAL hthick, BYVAL vthick, BYVAL ulpen, BYVAL lrpen)
  26.     LOCAL bottom, right
  27.  
  28.     bottom = t + h - 1
  29.     right = l + w - 1
  30.  
  31.     ' upper right edges
  32.     SetAPen rp&, ulpen
  33.  
  34.     Move rp&, l, bottom - 1
  35.     Draw rp&, l, t
  36.     Draw rp&, right - 1, t
  37.  
  38.     ' lower right edges
  39.     SetAPen rp&, lrpen
  40.  
  41.     Move rp&, right, t + 1
  42.     Draw rp&, right, bottom
  43.     Draw rp&, l + 1, bottom
  44. END SUB
  45.  
  46. FUNCTION drawEmB&(BYVAL cl&, BYVAL o&, BYVAL msg&)
  47.     LOCAL pens&, state&
  48.     LOCAL l, t, w, h
  49.     LOCAL ulpen, lrpen, fillpen
  50.  
  51.     ' let's be sure that we were passed a DrawInfo
  52.     IF PEEKL(msg& + impDrawimp_DrInfo) THEN
  53.         pens& = PEEKL(PEEKL(msg& + impDrawimp_DrInfo) + dri_Pens)
  54.     ELSE
  55.         pens& = NULL&
  56.     END IF
  57.     
  58.     l = PEEKW(o& + ImageLeftEdge) + PEEKW(msg& + impDrawimp_Offset)
  59.     t = PEEKW(o& + ImageTopEdge) + PEEKW(msg& + impDrawimp_Offset + 2)
  60.     w = PEEKW(o& + ImageWidth)
  61.     h = PEEKW(o& + ImageHeight)
  62.  
  63.     state& = PEEKL(msg& + imp_State)
  64.     SELECT CASE state&
  65.         CASE IDS_SELECTED&, IDS_INACTIVESELECTED&
  66.             IF pens& <> NULL& THEN
  67.                 ulpen = PEEKW(pens& + SHADOWPEN& * 2)
  68.                 lrpen = PEEKW(pens& + SHINEPEN& * 2)
  69.                 fillpen = PEEKW(pens& + FILLPEN& * 2)
  70.             ELSE
  71.                 ulpen = 2
  72.                 lrpen = 1
  73.                 fillpen = 3
  74.             END IF
  75.         
  76.         CASE REMAINDER
  77.             IF pens& <> NULL& THEN
  78.                 ulpen = PEEKW(pens& + SHINEPEN& * 2)
  79.                 lrpen = PEEKW(pens& + SHADOWPEN& * 2)
  80.                 fillpen = PEEKW(pens& + BACKGROUNDPEN& * 2)
  81.             ELSE
  82.                 ulpen = 2
  83.                 lrpen = 1
  84.                 fillpen = 3
  85.             END IF
  86.     END SELECT
  87.  
  88.     embossedBoxTrim PEEKL(msg& + impDrawimp_RPort), l, t, w, h, _
  89.       LINEWIDTH, LINEWIDTH, ulpen, lrpen
  90.  
  91.     interiorBox PEEKL(msg& + impDrawimp_RPort), l, t, w, h, _
  92.       LINEWIDTH, LINEWIDTH, fillpen
  93.     drawEmB& = TRUE&
  94. END FUNCTION
  95.  
  96. '
  97. ' Class Despatcher
  98. '
  99. FUNCTION despatchEmBClass&(BYVAL cl&, BYVAL o&, BYVAL msg&)
  100.     LOCAL methodID&
  101.     
  102.     methodID& = PEEKL(msg& + MsgMethodID)
  103.     SELECT CASE methodID&
  104.         CASE IM_DRAW&    ' draw with state
  105.             despatchEmBClass& = drawEmB&(cl&, o&, msg&)
  106.         
  107.         CASE REMAINDER
  108.             'use superclass defaults for everything else
  109.  
  110.             despatchEmBClass& = DoSuperMethodA&(cl&, o&, msg&)
  111.     END SELECT
  112. END FUNCTION
  113.  
  114. '
  115. ' Private class initialization
  116. '
  117. FUNCTION initEmBClass&
  118.     STATIC cl&
  119.  
  120.     cl& = MakeClass&(NULL&, SADD("imageclass" + CHR$(0)), NULL&, 0, 0)
  121.     IF cl& <> NULL& THEN InitHook cl& + cl_Dispatcher, VARPTRS(despatchEmBClass&)
  122.     initEmBClass& = cl&
  123. END FUNCTION
  124.  
  125. '
  126. ' Private class termination
  127. '
  128. FUNCTION freeEmBClass&(BYVAL cl&)
  129.     freeEmBClass& = FreeClass&(cl&)
  130. END FUNCTION
  131.